home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 …SCII & the Runetime Code / ADC Developer CD (1992-07) (''Butch ASCII And The Runtime Code'')_iso / Dev.CD 199207.iso / Developer Essentials / DTS Sample Code / Macintosh Sample Code / SC.012.Signals / PTestSignal.p < prev    next >
Encoding:
Text File  |  1992-06-10  |  2.9 KB  |  135 lines  |  [TEXT/MPS ]
  1. {------------------------------------------------------------------------------
  2. #
  3. #    Apple Macintosh Developer Technical Support
  4. #
  5. #    Exception handling for MPW Pascal, MacApp and MPW C
  6. #
  7. #    UFailure (aka Signals) - “Exceptional code, with a few exceptions.”
  8. #
  9. #    PTestSignal.p    -    Test tool for Pascal access to enhanced UFailure
  10. #
  11. #    Copyright © 1985-1988 Apple Computer, Inc.
  12. #    All rights reserved.
  13. #
  14. #    Versions:    1.00                11/88
  15. #                1.01                06/92
  16. #
  17. #    Components:    CTestSignal.c        November 1, 1988
  18. #                CTestSignal.make    November 1, 1988
  19. #                PTestSignal.p        November 1, 1988
  20. #                PTestSignal.make    November 1, 1988
  21. #                UFailure.p            November 1, 1988
  22. #                UFailure.h            November 1, 1988
  23. #                UFailure.incl.p        November 1, 1988
  24. #                UFailure.a            November 1, 1988
  25. #
  26. #    UFailure (or Signals) is a set of exception handling routines suitable for
  27. #    use with MacApp, MPW C, and MPW Pascal. It is a jazzed-up version of the MacApp
  28. #    UFailure unit. There is a set of C interfaces to it as well.
  29. #
  30. ------------------------------------------------------------------------------}
  31.  
  32. Program TestSignals;
  33.  
  34. USES
  35.     MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf,
  36.     UFailure;
  37. {$D+}
  38.  
  39.  
  40. PROCEDURE DoCatchOutMain(s:STRING; long:LONGINT);
  41. BEGIN
  42.     Writeln(s, long:2);
  43.     Exit(TestSignals);
  44. END; {DoCatchOutMain}
  45.  
  46.         
  47.  
  48.  
  49. FUNCTION Value:LONGINT;
  50.     VAR
  51.         code:    INTEGER;
  52.         
  53.     PROCEDURE Never;
  54.         VAR
  55.             code:    INTEGER;
  56.             fi:        FailInfo;
  57.     
  58.         PROCEDURE Handler(code: INTEGER; message: LONGINT);
  59.             BEGIN
  60.                 Writeln('Handler from Never; message = ',message:2,', code = ',code:2);
  61.                 {this will do an implicit Failure() when it exits}
  62.             END;
  63.  
  64.         BEGIN {Never}
  65.             CatchFailures(fi, Handler);
  66.     
  67.             code := CatchSignal;
  68.             IF code <> 0 THEN BEGIN
  69.                 Writeln('Never shouldn’t get here; code=', code:2);
  70.                 Value := code;
  71.                 Exit(Never);
  72.             END;
  73.         
  74.             FreeSignal; {"free" the last CatchSignal}
  75.             
  76.             SignalMessage(7, 77777); {Signal a 7 to the last Catch (in this case}
  77.         END;{Never}
  78.  
  79.  
  80.     PROCEDURE Failer;
  81.         BEGIN
  82.             IF CatchSignal = 0 THEN
  83.                 Never;
  84.             
  85.             Failure(69, 0);            {fail no matter what}
  86.         END; {Failer}
  87.         
  88.     BEGIN {Value}
  89.         code := CatchSignal;
  90.         IF code <> 0 THEN BEGIN
  91.             Writeln('Shouldn’t be here in Value, code=', code:2);
  92.             Value := code;
  93.             Exit(Value);
  94.         END;
  95.         
  96.         {when this does its return the CatchSignal above will be automatically popped}
  97.         code := CatchSignal;
  98.         IF code <> 0 THEN BEGIN
  99.             Value := code;
  100.             Exit(Value);
  101.         END;
  102.         
  103.         Failer;
  104.     END;{Value}
  105.  
  106. PROCEDURE Main;
  107.     
  108.     VAR
  109.         aString:        Str255;
  110.         code:            INTEGER;
  111.         registerLong:    LONGINT;
  112.  
  113.     BEGIN
  114.  
  115.         registerLong := 0;
  116.         
  117.         {catch Signals not otherwise caught by the program}
  118.         code := CatchSignal;
  119.         IF code <> 0 THEN BEGIN
  120.             NumToString(code, aString);
  121.             aString := Concat('Signal caught from main, code = ',aString,
  122.                 ', registerLong = ');
  123.             DoCatchOutMain(aString, registerLong);
  124.         END;
  125.         
  126.         registerLong := $FFFF;
  127.         
  128.         Signal(Value);
  129.     END; {Main}
  130.     
  131. BEGIN {PROGRAM}
  132.     InitSignals; {Call this with other (i.e. toolbox) inits}
  133.     Main;
  134. END.
  135.